home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Overload Trio 2
/
Shareware Overload Trio Volume 2 (Chestnut CD-ROM).ISO
/
dir42
/
c7105.zip
/
FORMGRPS.TPX
< prev
next >
Wrap
Text File
|
1994-03-02
|
56KB
|
1,062 lines
#!┌───────────────────────────┤Template Segment├───────────┬─────────────────┐
#!│ FormGrps.TPX │Version: 3007.105│
#!├───────────────────────────────┤Contents├───────────────┴─────────────────┤
#!│Structure Type Description │
#!│──────────────────── ───────── ─────────────────────────────────────────│
#!│InitQue GROUP │
#!│InitFields GROUP │
#!│SecondaryLookups GROUP │
#!│InsertMessage GROUP │
#!│ChangeMessage GROUP │
#!│DeleteMessage GROUP │
#!│AutoIncCode GROUP │
#!│RestoreAuto GROUP │
#!│SetupConcurrency GROUP │
#!│ConflictUpdate GROUP │
#!│DupKeyCode GROUP │
#!│ClearValues GROUP │
#!│InitFormSymbols GROUP │
#!│UpdateRelationSearch GROUP │
#!│DeleteRelationSearch GROUP │
#!│RelationalAccessFlds GROUP │
#!│GenFormulas GROUP │
#!│SecondaryChanged GROUP │
#!│FieldDups GROUP │
#!│SaveScrFlds GROUP │
#!│DupFldCall GROUP │
#!│DupField GROUP │
#!│InitButtonExist GROUP │
#!│AltKeys GROUP │
#!│ProcCounter GROUP │
#!│SavePrimedFields GROUP │
#!│InitAutoInc GROUP │
#!├───────────────────────────────┤Comments├─────────────────────────────────┤
#!│Version Comments │
#!│──────── ────────────────────────────────────────────────────────────────│
#!│3007.000 Release of CDD3 version 3007 templates │
#!│3007.103 Repaired SecondaryLookups GROUP │
#!│ Repaired UpdateRelationSearch GROUP │
#!│ Repaired DeleteRelationSearch GROUP │
#!│3007.105 Repaired UpdateRelationSearch GROUP │
#!│ Repaired DeleteRelationSearch GROUP │
#!│ Repaired AutoIncCode GROUP │
#!│ Added InitAutoInc GROUP │
#!│ Repaired DupKeyCode GROUP │
#!└──────────────────────────────────────────────────────────────────────────┘
#!
#GROUP(%InitQue)
#IF(%SharedFiles)
!─────────────────────────────────────────────────────────────────────────────
InitializeQueue ROUTINE #<!save initial record values
FREE(RecordQueue)
Sav:SaveRecord = %FilePre:Record #<!Save the current record
#IF(%MemoChk)
#FOR(%FileMemo)
#FIX(%Field,%FileMemo)
SAV:%FieldID = %Field #<!Save the memo
#ENDFOR
#ENDIF
ADD(RecordQueue,1) #<!add record to Queue
ADD(RecordQueue,2) #<!add record again
IF ERRORCODE() #<!check Queue add error
CASE ERRORCODE()
OF NoMemErr #<!Is there enough memory?
#INSERT(%NotEnoughMemMsg)
ELSE #<!On any other error
#INSERT(%GeneralErrorMsg)
END #<!End CASE Errorcode
DISABLE(1,FIELDS()) #<!Disable the screen fields
#IF(%TableForm = %Null)
ENABLE(?Cancel) #<!Enable the Cancel button
SELECT(?Cancel) #<!Place the cursor on Cancel
#ELSIF(%TableForm)
#IF(%CancelExists = %Null)
ENABLE(%FirstField) #<!Enable the First Field
SELECT(%FirstField) #<!Place cursor on Cancel
PRESS(EscKey)
#ELSE
ENABLE(?Cancel) #<!Enable the Cancel button
SELECT(?Cancel) #<!Place the cursor on Cancel
#ENDIF
#ENDIF
DISPLAY #<!Update screen display
END #<!End IF Errorcode
EXIT
#ENDIF
#!***************************************************************************
#GROUP(%InitFields)
#IF(%InitRoutine = 'Y')
!─────────────────────────────────────────────────────────────────────────────
InitializeFields ROUTINE
#FOR(%Field)
#IF(%FieldInitial <> %NULL)
%Field = %FieldInitial
#ENDIF
#ENDFOR
#ENDIF
#!***************************************************************************
#GROUP(%SecondaryLookups)
#!
#!┌────────────────────────────┤Template Group├────────────┬─────────────────┐
#!│ SecondaryLookups │Version: 3007.103│
#!├──────────────────────────────┤Description├─────────────┴─────────────────┤
#!│Purpose: Generate SecondaryLookups ROUTINE │
#!│Called From: Form, MultiPage, PageOf │
#!│Assumptions: None │
#!│Inserts: GetSecondaryRecords │
#!│Symbols Set: None │
#!│Notes: None │
#!├───────────────────────────────┤Comments├─────────────────────────────────┤
#!│Version Comments │
#!│──────── ────────────────────────────────────────────────────────────────│
#!│3007.000 Release of CDD3 version 3007 templates │
#!│3007.103 Removed the DISPLAY statement from the GROUP │
#!└──────────────────────────────────────────────────────────────────────────┘
#!
!─────────────────────────────────────────────────────────────────────────────
SecondaryLookups ROUTINE
#INSERT(%GetSecondaryRecords) #<!Lookup into Secondary files
#!***************************************************************************
#GROUP(%InsertMessage)
#IF(%InsertMsg <> %NULL)
LOC:Message = CENTER('%InsertMsg',SIZE(LOC:Message)) #<!Assign ADD message
#ELSE
LOC:Message = CENTER(GLO:InsertMsg,SIZE(LOC:Message))#<!Assign ADD message
#ENDIF
#!***************************************************************************
#GROUP(%ChangeMessage)
#IF(%ChangeMsg <> %NULL)
LOC:Message = CENTER('%ChangeMsg',SIZE(LOC:Message)) #<!Assign CHANGE message
#ELSE
LOC:Message = CENTER(GLO:ChangeMsg,SIZE(LOC:Message))#<!Assign CHANGE message
#ENDIF
#!***************************************************************************
#GROUP(%DeleteMessage)
#IF(%DeleteMsg <> %NULL)
LOC:Message = CENTER('%DeleteMsg',SIZE(LOC:Message)) #<!Assign DELETE message
#ELSE
LOC:Message = CENTER(GLO:DeleteMsg,SIZE(LOC:Message))#<!Assign DELETE message
#ENDIF
#!***************************************************************************
#GROUP(%AutoIncCode)
#!
#!┌────────────────────────────┤Template Group├────────────┬─────────────────┐
#!│ AutoIncCode │Version: 3007.105│
#!├──────────────────────────────┤Description├─────────────┴─────────────────┤
#!│Purpose: Generate code to Automatically increment field values │
#!│Called From: Form and MultiPage Porcedure templates │
#!│Assumptions: None │
#!│Inserts: %GenerateFormula │
#!│Symbols Set: None │
#!│Notes: None │
#!├───────────────────────────────┤Comments├─────────────────────────────────┤
#!│Version Comments │
#!│──────── ────────────────────────────────────────────────────────────────│
#!│3007.000 Release of CDD3 version 3007 templates │
#!│3007.105 Repaired Descending Key code (clearing AutoIncrement field low) │
#!└──────────────────────────────────────────────────────────────────────────┘
#!
#IF(%AutoInc) #! If AutoInc Key exists
!─────────────────────────────────────────────────────────────────────────────
AutoNumber Routine #<! Generate AutoInc Values
DO SaveAutoNumber #<! Save AutoNum Prime Value
DO NextAutoNumber #<! Generate Next Autonumber
!─────────────────────────────────────────────────────────────────────────────
SaveAutoNumber ROUTINE #! Save AutoNum Prime Values
#FOR(%Formula) #! FOR each Formula
#IF(UPPER(%FormulaClass) = 'PRIMEKEY') #! IF it's a Prime Key formula
#INSERT(%GenerateFormula) #! Generate Formula Code
#ENDIF #! END (IF it's a Prime...)
#ENDFOR #! END (FOR each Formula)
#FIX(%File,%Primary) #! FIX to process Primary
#FOR(%Key) #! FOR each key
#IF(%KeyAuto) #! IF an AutoInc key
#FOR(%KeyField) #! FOR each field in key
#IF(%KeyField=%KeyAuto) #! IF the AutoInc field
#BREAK #! Stop processing key
#ENDIF #! END (IF the AutoInc field)
Auto:%KeyField = %KeyField #<! Save current key value
#ENDFOR #! END (FOR each field...)
Auto:%KeyAuto = 0 #<! Clear AutoInc Value
#IF(%AutoIncDups) #! If other Dup keys exist
Auto:Hold:%KeyAuto = 0 #<! Other Dup Key checking
#ENDIF #! END (If other Dup Keys)
#ENDIF #! END (IF an AutoInc key)
#ENDFOR #! END (FOR each key)
!─────────────────────────────────────────────────────────────────────────────
NextAutoNumber ROUTINE #<! Get next AutoNum Value
LOOP #<! Loop for autonumbering
#FOR(%Key) #! FOR each key
#IF(%KeyAuto) #! IF an AutoInc key
LOOP #<! Loop for %Key AutoInc
#FOR(%KeyField) #! FOR each field in key
#IF(%KeyField=%KeyAuto) #! IF the AutoInc field
#SET(%ClearWritten,%Null) #! Clear the flag
#FIX(%Field,%KeyField) #! Check Field Properties
#IF(UPPER(%FieldType) = 'PICTURE') #! IF AutoInc Picture data type
#IF(INSTRING('@N',UPPER(%FieldRecordPicture),1,1)) #! If its an @n picture
#SET(%ClearWritten,'TRUE') #! Set the Flag
#IF(%KeyFieldSequence = 'ASCENDING') #! IF Ascending Key Field
%KeyField = ALL('9') #<! Fill strings with 9's
#ELSE #! ELSE (IF NOT Ascending...)
%KeyField = ALL('0') #<! Fill strings with 0's
#ENDIF #! END (IF Ascending...)
#ENDIF #! END (IF its an @n...)
#ENDIF #! END (AutoInc Picture...)
#IF(NOT %ClearWritten) #! IF Flag not set
CLEAR(%KeyField,1) #<! Clear to high value
#ENDIF #! END (IF Flag not set)
#ELSE #! ELSE (IF NOT the AutoInc...)
%KeyField = Auto:%KeyField #<! Set to saved values
#ENDIF #! END (IF the AutoInc Field)
#ENDFOR #! END (For each field...)
#FIX(%KeyField,%KeyAuto) #! Set up to Gen Code
SET(%Key,%Key) #<! %KeyFieldSequence
#IF(%KeyFieldSequence='ASCENDING') #! IF Ascending Key
PREVIOUS(%Primary) #<! Read last record (Ascending)
#ELSE #! ELSE (NOT Ascending Key)
NEXT(%Primary) #<! Read first record (Descending)
#ENDIF #! END (IF Ascending Key)
IF ERRORCODE() = BadRecErr #<! IF No Records
Auto:%KeyAuto = 1 #<! then start numbering at 1
ELSIF ERRORCODE() #<! On any other error
#INSERT(%KeyedRecordReadMsg) #! Alert the User
DO ProcedureReturn #<! and leave the proc
ELSE #<! ELSE (No Errorcode)
#SET(%IfWritten,%Null) #! Clear the Flag
#SET(%LastKeyField,%Null) #! Clear the Flag
#FOR(%KeyField) #! FOR each field in key
#IF(%KeyField=%KeyAuto) #! IF the AutoInc field
#BREAK #! Stop processing key
#ENDIF #! END (IF the AutoInc field)
#SET(%LastKeyField,%KeyField) #! Set the Flag
#ENDFOR #! END (FOR each field...)
#IF(%LastKeyField) #! IF multiple field key
#FOR(%KeyField) #! FOR each field in key
#IF(%KeyField=%LastKeyField) #! IF this element is last
#IF(%IfWritten) #! IF flag is set
AND Auto:%KeyField = %KeyField #<! Check for valid value
#ELSE #! ELSE (IF flag is not set)
IF Auto:%KeyField = %KeyField #<! IF valid value
#ENDIF #! END (IF flag is set)
#BREAK #! Stop Processing Key
#ELSE #! ELSE (IF not last...)
#IF(%IfWritten) #! IF flag is set
AND Auto:%KeyField = %KeyField| #<! Check for valid value
#ELSE #! ELSE (IF flag is not set)
IF Auto:%KeyField = %KeyField| #<! IF valid value
#SET(%IfWritten,'TRUE') #! SET the Flag
#ENDIF #! END (IF flag is set)
#ENDIF #! END (IF this element...)
#ENDFOR #! END (FOR each field...)
Auto:%KeyAuto = %KeyAuto + 1 #<! Get next value
ELSE #<! IF not valid value
Auto:%KeyAuto = 1 #<! Get first value
END #<! END (IF valid value)
#ELSE #! ELSE (IF NOT multiple...)
Auto:%KeyAuto = %KeyAuto + 1 #<! Get next value
#ENDIF #! END (FOR each field...)
END #<! END (IF No Records)
#FOR(%KeyField) #! FOR each field in key
%KeyField = Auto:%KeyField #<! Restore key value
#IF(%KeyField=%KeyAuto) #! IF the AutoInc field
#BREAK #! Stop processing key
#ENDIF #! END (IF the AutoInc field)
#ENDFOR #! END (FOR each field...)
IF DUPLICATE(%Key) #<! IF value already exists
CYCLE #<! Try again
END #<! END (IF Value already...)
BREAK #<! Quit processing this key
END #<! END (Loop for %Key ...)
#ENDIF #! End IF %KeyAuto
#ENDFOR #! End FOR KEY
#INSERT(%ClearValues) #! Clear the Record
#FOR(%Key) #! FOR each Key
#IF(%KeyAuto) #! IF an AutoInc Key
#FOR(%KeyField) #! FOR each field of key
%KeyField = Auto:%KeyField #<! Restore values
#IF(%KeyField=%KeyAuto) #! IF the AutoInc field
#BREAK #! Stop processing key
#ENDIF #! END (IF the AutoInc field)
#ENDFOR #! END (FOR each field...)
#ENDIF #! END (IF an AutoInc Key)
#ENDFOR #! END (FOR each Key)
ADD(%Primary) #<! Add the record now
IF ERRORCODE() #<! Was there an error?
CASE ERRORCODE() #<! Process errors
OF DupKeyErr #<! Is it a duplicate key?
#IF(%AutoIncDups) #! If other Dup keys exist
#SET(%KeyCounter,%Null) #! Clear the counter
#SET(%IfWritten,%Null) #! Clear the flag
#FOR(%Key) #! FOR each Key
#IF(%KeyAuto) #! IF an AutoInc Key
#SET(%KeyCounter,(%KeyCounter+1)) #! Increment the Counter
#ENDIF #! END (IF an AutoInc Key)
#ENDFOR #! END (FOR each Key)
#FOR(%Key) #! FOR each Key
#IF(%KeyAuto) #! IF an AutoInc Key
#IF(%KeyCounter='1') #! IF the last AutoInc Key
#IF(%IfWritten) #! If the flag is set
AND Auto:Hold:%KeyAuto = %KeyAuto #<! Same value as last time
#ELSE #! ELSE (If the flag is not...)
IF Auto:Hold:%KeyAuto = %KeyAuto #<! Same value as last time
#ENDIF #! END (If the flag is set)
#ELSE #! END (IF NOT the last AutoInc Key)
#IF(%IfWritten) #! If the flag is set
AND Auto:Hold:%KeyAuto = %KeyAuto| #<! Same value as last time
#ELSE #! ELSE (If the flag is not...)
IF Auto:Hold:%KeyAuto = %KeyAuto| #<! Same value as last time
#SET(%IfWritten,'TRUE') #! Set the flag
#ENDIF #! END (If the flag is set)
#ENDIF #! END (IF the last AutoInc Key)
#SET(%KeyCounter,(%KeyCounter-1)) #! Increment the Counter
#ENDIF #! END (IF an AutoInc Key)
#ENDFOR #! END (FOR each Key)
#INSERT(%AutoIncDuplicateMsg) #! Alert the User
ELSE #<! ELSE (If not same as last)
#FOR(%Key) #! FOR each Key
#IF(%KeyAuto) #! IF an AutoInc Key
Auto:Hold:%KeyAuto = %KeyAuto #! Save Value for next time
#ENDIF #! END (IF an AutoInc Key)
#ENDFOR #! END (FOR each Key)
CYCLE #<! then try again
END #<! END (IF the same as...)
#ELSE #! ELSE (If other Dup Keys...)
CYCLE #<! then try again
#ENDIF #! END (If other Dup Keys exist)
ELSE #<! ELSE (unexplained error)
IF DiskError('Record could not be ADDed')#<! Check any other error
DO ProcedureReturn #<! Leave the procedure
END #<! End IF Diskerror
END #<! End CASE errorcode
ELSE #<! Else no error
BREAK #<! so BREAK Loop
END #<! End IF errorcode
END #<! End LOOP for Autonumbering
AutoIncAdd = True #<! Switch AutoIncAdd ON
AutoAddPtr = POSITION(%Primary) #<! Save the record position
RESET(%Primary,AutoAddPtr) #<! Position to record we added
#IF(%SharedFiles) #! IF generating MultiUser code
HOLD(%Primary,4) #<! Hold the record
NEXT(%Primary) #<! and read it in to buffer
IF DiskError('Could not READ Record') #<! Check for I/O error
DO ProcedureReturn #<! Leave the procedure
END #<! End IF Diskerror
#ENDIF
Action = ChangeRecord #<! Action is now change
EXIT #<! Exit the routine
#ENDIF
#!***************************************************************************
#GROUP(%RestoreAuto)
#FOR(%Key)
#IF(%KeyAuto <> %NULL)
%KeyAuto = %KeyAuto:AutoInc# #<!Restore incremented value
#ENDIF
#ENDFOR
#!***************************************************************************
#GROUP(%SetupConcurrency)
DO InitializeQueue #<!Save record to QUEUE
SavePointer = POSITION(%Primary) #<!Save the record position
#!***************************************************************************
#GROUP(%ConflictUpdate)
PUT(RecordQueue) #<!Update the memory Queue
#INSERT(%RecordChangedMsg)
SELECT(1) #<!Place cursor on 1st field
DISPLAY #<!Update the screen
AbortTransaction = True #<!Turn AbortWrite# ON
EXIT #<!Exit the Routine
#!***************************************************************************
#GROUP(%DupKeyCode)
#!
#!┌────────────────────────────┤Template Group├────────────┬─────────────────┐
#!│ DupKeyCode │Version: 3007.105│
#!├──────────────────────────────┤Description├─────────────┴─────────────────┤
#!│Purpose: Generate check of each key that is unique for duplicates │
#!│Called From: Form PROCEDURE │
#!│ MultiPage PROCEDURE │
#!│Assumptions: None │
#!│Inserts: DupKeyErrorMsg │
#!│Symbols Set: None │
#!│Notes: None │
#!├───────────────────────────────┤Comments├─────────────────────────────────┤
#!│Version Comments │
#!│──────── ────────────────────────────────────────────────────────────────│
#!│3007.000 Release of CDD3 version 3007 templates │
#!│3007.105 Moved Error message to DupKeyErrorMsg in Warnings.TPX │
#!└──────────────────────────────────────────────────────────────────────────┘
#!
#FIX(%File,%Primary)
IF ERRORCODE() = DupKeyErr #<! Duplicate key detected
#FOR(%Key)
#IF(UPPER(%KeyDuplicate) <> 'Y')
IF DUPLICATE(%Key) #<!check unique keys
#IF(%SharedFiles = 'TRUE')
RELEASE(%File) #<!Release the HOLD
#ENDIF
#INSERT(%DupKeyErrorMsg)
END
#ENDIF
#ENDFOR
SELECT(1) #<!select first field
DISPLAY #<!re-display the screen
CYCLE #<!back to main loop
END #<!End IF Duplicate errorcode
#!***************************************************************************
#GROUP(%ClearValues)
CLEAR(%FilePre:Record) #<!CLEAR Record buffer
#FOR(%FileMemo)
CLEAR(%FileMemo) #<!CLEAR Memo buffer
#ENDFOR
#!***************************************************************************
#GROUP(%InitFormSymbols)
#! INITIALIZE FORM TEMPLATE SYMBOLS
#!────────────────────────────────────────────────────────────────────────────
#!User Defined Symbols Purpose/Meaning
#!────────────────────────────────────────────────────────────────────────────
#SET(%HotKeysExist,%Null) #!Do Hot Keys Exist
#SET(%AutoInc,%Null) #!Does %Primary use an Auto-Increment key
#SET(%DupKeyCheck,%Null) #!Does a ,DUP key exist for %Primary
#SET(%LoopFormulasExist,%Null) #!Do unclassed formulas exist?
#SET(%PrimeKeysExist,%Null) #!Are there any PrimeKey formulas
#SET(%MemoChk,%Null) #!Are any memos present in Primary
#SET(%InitRoutine,%Null) #!Do any fields have initial values?
#SET(%FileControlMode,%Null) #!Controls writing of file opening/closing
#SET(%ControlLookups,'Y') #!Searches Lookups for opening/closing
#SET(%ControlRelatedFiles,'Y') #!Searches relations for opening/closing
#SET(%RelatedFileListing,%Null) #!List Containing Related Files
#SET(%LevelOne,%Null) #!
#SET(%LevelOneLinks,%Null) #!
#SET(%LinkPool,%Null) #!
#SET(%RelatedFiles,%Null) #!
#SET(%RestrictDelete,%Null) #!
#SET(%RestrictUpdate,%Null) #!
#SET(%CascadeDelete,%Null) #!
#SET(%CascadeUpdate,%Null) #!
#SET(%ClearOnDelete,%Null) #!
#SET(%ClearOnUpdate,%Null) #!
#SET(%SecondaryExist,%Null) #!
#SET(%PrimaryUpdateConst,%Null)
#SET(%PrimaryDeleteConst,%Null)
#SET(%RelationString,%Null)
#SET(%ChildPre,%Null)
#SET(%ParentPre,%Null)
#SET(%AllRelations,%Null)
#SET(%RelatedChildList,%Null)
#SET(%RelatedParentList,%Null)
#SET(%UpdateRelations,%Null)
#SET(%UpdateChildList,%Null)
#SET(%UpdateParentList,%Null)
#SET(%DeleteRelations,%Null)
#SET(%DeleteChildList,%Null)
#SET(%DeleteParentList,%Null)
#SET(%ControlRelatedFiles,'TRUE')
#SET(%NonStopSelect,'TRUE')
#FIX(%File,%Primary) #!Prime File symbols
#SET(%PrimaryDriver,%FileType) #!Retrieve the file driver
#FOR(%HotKey) #!For Each Hot Key
#IF(%HotKeyProc) #!If there is a procedure
#SET(%HotKeysExist,'Y') #!Set the flag
#BREAK #!and stop looking
#ENDIF #!END (if %HotKeyProc)
#ENDFOR #!END (for %HotKey)
#FOR(%Key) #!For each key of %Primary
#IF(%KeyAuto) #!If asks for Auto Increment
#SET(%AutoInc,'Y') #!Set the flag
#ENDIF #!END (if %KeyAuto)
#IF(%KeyDuplicate <> 'Y') #!If dup checking needed
#SET(%DupKeyCheck,'Y') #!Set the Flag
#ENDIF #!END (if %KeyDuplicate)
#ENDFOR #!END (for %Key)
#FOR(%Formula) #!For each formula
#IF(UPPER(%FormulaClass) = '') #!If there's no class
#SET(%LoopFormulasExist,'Y') #!Flag for loop processing
#ENDIF #!END (if formulaclass = '')
#IF(UPPER(%FormulaClass) = 'PRIMEKEY') #!Formula primes key values
#SET(%PrimeKeysExist,'Y') #!Set the Flag
#ENDIF #!END (if formulaclass = 'P...')
#ENDFOR #!END (for %Formula)
#FOR(%FileMemo) #!For each memo field
#SET(%MemoChk,'Y') #!Set a flag that one exists
#BREAK #!and stop looking
#ENDFOR #!END (for %FileMemo)
#FOR(%Field) #!For each field of Primary
#IF(%FieldInitial <> %NULL) #!If Field has initial value
#SET(%InitRoutine,'Y') #!Flag for initializing code
#BREAK #!and quit looking
#ENDIF #!END (if %FieldInitial)
#ENDFOR #!END (for Field)
#SET(%ProcessingFile,%Primary) #!Set for Relations Search
#INSERT(%UpdateRelationSearch) #!Retrieves Relations
#SET(%ProcessingFile,%Primary) #!Set for Relations Search
#INSERT(%DeleteRelationSearch) #!Retrieves Relations
#FOR(%Secondary) #!For each secondary file
#IF(%SecondaryType = 'MANY:1') #!If relation = Many:1
#SET(%SecondaryExist,'Y') #!Set SecondaryExist flag
#ENDIF #!END (if SecondaryType = Many:1)
#ENDFOR #!END (for Secondary)
#!***************************************************************************
#GROUP(%UpdateRelationSearch)
#!
#!┌────────────────────────────┤Template Group├────────────┬─────────────────┐
#!│ UpdateRelationSearch │Version: 3007.105│
#!├──────────────────────────────┤Description├─────────────┴─────────────────┤
#!│Purpose: Generate Symbols for RI Update code │
#!│Called From: InitFormSymbols GROUP │
#!│Assumptions: That %ProcessingFile contains the label of a file │
#!│Inserts: UpdateRelationSearch (Recursive) │
#!│Symbols Set: %AllRelations │
#!│ Contains listing of all CONSTRAINED 1:Many Relations │
#!│ %RelatedParentListing │
#!│ Contains listing of all files in procedure acting as │
#!│ the Parent in a 1:Many Relation │
#!│ %RelatedChildListing │
#!│ Contains listing of all files in procedure acting as │
#!│ the Child in a 1:Many Relation │
#!│ %UpdateParentListing │
#!│ Contains listing of all files in procedure acting as │
#!│ the Parent in a 1:Many Relation with update constraints │
#!│ %UpdateChildListing │
#!│ Contains listing of all files in procedure acting as │
#!│ the Child in a 1:Many Relation with update constraints │
#!│Notes: The listings maintained in the above symbols use file │
#!│ PREFIXes, rather than labels. The use of PREFIXes allows │
#!│ us to handle many more files, since we are storing relations│
#!│ in, effectively, string variables. by using PREFIXes, we │
#!│ get many more relations recorded and handled. │
#!├───────────────────────────────┤Comments├─────────────────────────────────┤
#!│Version Comments │
#!│──────── ────────────────────────────────────────────────────────────────│
#!│3007.000 Release of CDD3 version 3007 templates │
#!│3007.103 Repaired recursive call. The recursive call was taking place │
#!│ too deep in the #IF stack (three #IFs per iteration). The │
#!│ recursive call was moved to take place only one level of #IF │
#!│ deep, which (theoretically) should move the limiting factor │
#!│ on levels of recursion to the #FOR stack. │
#!│3007.105 Added percent symbols to the line that #SETs %RelationString. │
#!│ This bug caused no immediate generator errors, as the 3007 │
#!│ Generator strips out the % symbols in evaluated expressions, but│
#!│ is fixed for consistancy. │
#!└──────────────────────────────────────────────────────────────────────────┘
#!
#FIX(%File,%ProcessingFile)
#SET(%ProcessingFile,%Null)
#FOR(%Relation)
#IF(%RelationType = '1:MANY')
#IF(%RelationConstraintUpdate)
#SET(%NoLinkFound,%Null)
#FOR(%RelationKeyField)
#IF(UPPER(%RelationKeyFieldLink)='TODO')
#ERROR(' DICTIONARY ERROR!')
#SET(%ErrorMessage,(' The Relation: ' & %File & '─' & %Relation))
#ERROR(%ErrorMessage)
#ERROR(' contains undefined (TODO) links.')
#ERROR(' Code generated will NOT compile')
#ERROR('')
#ELSIF(%RelationKeyFieldLink)
#IF(%NoLinkFound)
#ERROR(' DICTIONARY ERROR!')
#SET(%ErrorMessage,(' The Relation: ' & %File & '─' & %Relation))
#ERROR(%ErrorMessage)
#ERROR(' is an unenforcable constrained UPDATE relation.')
#ERROR(' A non-linked key element on the MANY side of a')
#ERROR(' relation may not be followed by linked key elements.')
#ERROR(' Code generated will NOT compile')
#ERROR('')
#ENDIF
#ELSE
#SET(%NoLinkFound,'TRUE')
#ENDIF
#ENDFOR
#ENDIF
#SET(%RelationString,('['&%FilePre&'∙'&%RelationPre&']'))
#SET(%ParentPre,('['&%FilePre&']'))
#SET(%ChildPre,('['&%RelationPre&']'))
#IF((INSTRING(%ParentPre,%RelatedParentList,1,1))=0)
#SET(%RelatedParentList,(%RelatedParentList&%ParentPre))
#ENDIF
#IF((INSTRING(%ChildPre,%RelatedChildList,1,1))=0)
#SET(%RelatedChildList,(%RelatedChildList&%ChildPre))
#ENDIF
#IF(%RelationConstraintUpdate)
#SET(%UpdateRelations,(%UpdateRelations&%RelationString))
#SET(%AllRelations,(%AllRelations&%RelationString))
#IF((INSTRING(%ParentPre,%UpdateParentList,1,1))=0)
#SET(%UpdateParentList,(%UpdateParentList&%ParentPre))
#ENDIF
#IF((INSTRING(%ChildPre,%UpdateChildList,1,1))=0)
#SET(%UpdateChildList,(%UpdateChildList&%ChildPre))
#ENDIF
#SET(%ProcessingFile,%Null)
#IF(%RelationConstraintUpdate<>'RESTRICT')
#SET(%ProcessingFile,%Relation)
#ENDIF
#ENDIF
#ENDIF
#IF(%ProcessingFile)
#INSERT(%UpdateRelationSearch)
#ENDIF
#ENDFOR
#!***************************************************************************
#GROUP(%DeleteRelationSearch)
#!
#!┌────────────────────────────┤Template Group├────────────┬─────────────────┐
#!│ DeleteRelationSearch │Version: 3007.105│
#!├──────────────────────────────┤Description├─────────────┴─────────────────┤
#!│Purpose: Generate Symbols for RI Delete code │
#!│Called From: InitFormSymbols GROUP │
#!│Assumptions: That %ProcessingFile contains the label of a file │
#!│Inserts: DeleteRelationSearch (Recursive) │
#!│Symbols Set: %AllRelations │
#!│ Contains listing of all CONSTRAINED 1:Many Relations │
#!│ %RelatedParentListing │
#!│ Contains listing of all files in procedure acting as │
#!│ the Parent in a 1:Many Relation │
#!│ %RelatedChildListing │
#!│ Contains listing of all files in procedure acting as │
#!│ the Child in a 1:Many Relation │
#!│ %DeleteParentListing │
#!│ Contains listing of all files in procedure acting as │
#!│ the Parent in a 1:Many Relation with update constraints │
#!│ %DeleteChildListing │
#!│ Contains listing of all files in procedure acting as │
#!│ the Child in a 1:Many Relation with update constraints │
#!│Notes: The listings maintained in the above symbols use file │
#!│ PREFIXes, rather than labels. The use of PREFIXes allows │
#!│ us to handle many more files, since we are storing relations│
#!│ in, effectively, string variables. by using PREFIXes, we │
#!│ get many more relations recorded and handled. │
#!├───────────────────────────────┤Comments├─────────────────────────────────┤
#!│Version Comments │
#!│──────── ────────────────────────────────────────────────────────────────│
#!│3007.000 Release of CDD3 version 3007 templates │
#!│3007.103 Repaired recursive call. The recursive call was taking place │
#!│ too deep in the #IF stack (three #IFs per iteration). The │
#!│ recursive call was moved to take place only one level of #IF │
#!│ deep, which (theoretically) should move the limiting factor │
#!│ on levels of recursion to the #FOR stack. │
#!│3007.105 Added percent symbols to the line that #SETs %RelationString. │
#!│ This bug caused no immediate generator errors, as the 3007 │
#!│ Generator strips out the % symbols in evaluated expressions, but│
#!│ is fixed for consistancy. │
#!└──────────────────────────────────────────────────────────────────────────┘
#!
#FIX(%File,%ProcessingFile)
#SET(%ProcessingFile,%Null)
#FOR(%Relation)
#IF(%RelationType = '1:MANY')
#IF(%RelationConstraintDelete)
#SET(%NoLinkFound,%Null)
#FOR(%RelationKeyField)
#IF(UPPER(%RelationKeyFieldLink)='TODO')
#ERROR(' DICTIONARY ERROR!')
#SET(%ErrorMessage,(' The Relation: ' & %File & '─' & %Relation))
#ERROR(%ErrorMessage)
#ERROR(' contains undefined (TODO) links.')
#ERROR(' Code generated will NOT compile')
#ERROR('')
#ELSIF(%RelationKeyFieldLink)
#IF(%NoLinkFound)
#ERROR(' DICTIONARY ERROR!')
#SET(%ErrorMessage,(' The Relation: ' & %File & '─' & %Relation))
#ERROR(%ErrorMessage)
#ERROR(' is an unenforcable constrained DELETE relation.')
#ERROR(' A non-linked key element on the MANY side of a')
#ERROR(' relation may not be followed by linked key elements.')
#ERROR(' Code generated will NOT compile')
#ERROR('')
#ENDIF
#ELSE
#SET(%NoLinkFound,'TRUE')
#ENDIF
#ENDFOR
#ENDIF
#SET(%RelationString,('['&%FilePre&'∙'&%RelationPre&']'))
#SET(%ParentPre,('['&%FilePre&']'))
#SET(%ChildPre,('['&%RelationPre&']'))
#IF((INSTRING(%ParentPre,%RelatedParentList,1,1))=0)
#SET(%RelatedParentList,(%RelatedParentList&%ParentPre))
#ENDIF
#IF((INSTRING(%ChildPre,%RelatedChildList,1,1))=0)
#SET(%RelatedChildList,(%RelatedChildList&%ChildPre))
#ENDIF
#IF(%RelationConstraintDelete)
#SET(%DeleteRelations,(%DeleteRelations&%RelationString))
#IF((INSTRING(%RelationString,%AllRelations,1,1))=0)
#SET(%AllRelations,(%AllRelations&%RelationString))
#ENDIF
#IF((INSTRING(%ParentPre,%DeleteParentList,1,1))=0)
#SET(%DeleteParentList,(%DeleteParentList&%ParentPre))
#ENDIF
#IF((INSTRING(%ChildPre,%DeleteChildList,1,1))=0)
#SET(%DeleteChildList,(%DeleteChildList&%ChildPre))
#ENDIF
#IF(%RelationConstraintDelete<>'RESTRICT')
#SET(%ProcessingFile,%Relation)
#ENDIF
#ENDIF
#ENDIF
#IF(%ProcessingFile)
#INSERT(%DeleteRelationSearch)
#ENDIF
#ENDFOR
#!*************************************************************************
#GROUP(%RelationalAccessFlds)
#FOR(%File)
#SET(%ParentPre,('['&%FilePre&']'))
#IF((INSTRING(%ParentPre,%RelatedParentList,1,1)))
#FOR(%Relation)
#SET(%RelationString,('['&FilePre&'∙'&RelationPre&']'))
#IF((INSTRING(%RelationString,%AllRelations,1,1)))
#FOR(%RelationKeyField)
#IF(%RelationKeyFieldLink <> %NULL)
#FIX(%Field,%RelationKeyFieldLink)
#IF(%FieldType = 'GROUP')
%RelationPre::%RelationKeyFieldLink LIKE(%RelationKeyFieldLink),PRE(LNK) #<!Define a link field
#ELSE
%RelationPre::%RelationKeyFieldLink LIKE(%RelationKeyFieldLink) #<!Define a link field
#ENDIF
#ENDIF
#ENDFOR
#ENDIF
#ENDFOR
#ENDIF
#ENDFOR
#!**************************************************************************
#GROUP(%GenFormulas)
#IF(%GenerateFormulasOn)
!─────────────────────────────────────────────────────────────────────────────
FormulaFields ROUTINE
#FOR(%Formula)
#IF(UPPER(%FormulaClass) <> 'PRIMEKEY')
#IF(UPPER(%FormulaClass) <> 'SETUP')
#IF(UPPER(%FormulaClass) <> 'RETURN')
#IF(%CodePosition = %NULL OR %CodePosition = %FormulaClass)
#IF(%FormulaType = 'COMPUTED')
%Formula = %FormulaComputation #<!Computed Formula (no class)
#ELSE
IF %FormulaCondition #<!If Formula condition
%Formula = %FormulaTrue #<! is TRUE
#IF(%FormulaFalse)
ELSE ! else
%Formula = %FormulaFalse #<! condition is FALSE
#ENDIF
END #<!End formula condition
#ENDIF
#SET(%CurrentFormula,('?' & %Formula))
#FIX(%Screenfield,%CurrentFormula)
#IF(%Screenfield)
DISPLAY(?%Formula) #<!Update screen display
#ENDIF
#ENDIF
#ENDIF #!Not PrimeKey class
#ENDIF #!Not Setup class
#ENDIF #!Not Return class
#ENDFOR
#ENDIF
#!**************************************************************************
#GROUP(%SecondaryChanged)
#SET(%KeyFieldCounter,%Null)
#SET(%IfWritten,%Null)
#FOR(%Secondary) #! for fields on the form
#IF(%SecondaryType = 'MANY:1') #!Check for lookup files
#FIX(%File,%SecondaryTo)
#FIX(%Relation,%Secondary)
#FOR(%RelationKeyField)
#IF(RelationKeyFieldLink)
#SET(%KeyFieldCounter,(%KeyFieldCounter+1))
#ENDIF
#ENDFOR
#ENDIF
#ENDFOR
#FIX(%File,%Primary)
#IF(%KeyFieldCounter)
#FOR(%Secondary) #! for fields on the form
#IF(%SecondaryType = 'MANY:1') #!Check for lookup files
#FIX(%File,%SecondaryTo)
#FIX(%Relation,%Secondary)
#FOR(%RelationKeyField)
#IF(RelationKeyFieldLink)
#IF(%KeyFieldCounter='1')
#IF(%IfWritten)
OR %RelationKeyField <> %RelationKeyFieldLink #<!Check for changes
#ELSE
IF %RelationKeyField <> %RelationKeyFieldLink #<!Check for changes
#ENDIF
#BREAK
#ELSE
#IF(%IfWritten)
OR %RelationKeyField <> %RelationKeyFieldLink | #<!Check for changes
#ELSE
IF %RelationKeyField <> %RelationKeyFieldLink |#<!Check for changes
#SET(%IfWritten,'TRUE')
#ENDIF
#SET(%KeyFieldCounter,(%KeyFieldCounter-1))
#ENDIF
#ENDIF
#ENDFOR
#ENDIF
#ENDFOR
DO SecondaryLookups #<!Call lookup Routine
DISPLAY
END
#ENDIF
#!***************************************************************************
#GROUP(%FieldDups)
#FOR(%ScreenField)
#IF(%ScreenFieldUse)
#SET(%Fld,%ScreenFieldUse)
#FIX(%Field,%ScreenFieldUse)
#IF(SUB(%Fld,1,1) <> '?')
#IF(%FieldID)
#IF(UPPER(%FieldFile) = UPPER(%Primary))
#IF(%FieldDimension1)
#IF(INSTRING(%Field,%DimPool,1,1) = '0')
#SET(%DimPool,(%DimPool & ',' & %Field))
Dup::%Field LIKE(%Field)
#ENDIF
#ELSE
#IF(%FieldType = 'GROUP')
Dup::%ScreenFieldUse LIKE(%ScreenFieldUse),PRE(Dup)
#ELSE
Dup::%ScreenFieldUse LIKE(%ScreenFieldUse)
#ENDIF
#ENDIF
#ENDIF
#ENDIF
#ENDIF
#ENDIF
#ENDFOR
#!***************************************************************************
#GROUP(%SaveScrFlds)
!─────────────────────────────────────────────────────────────────────────────
SaveScrFlds ROUTINE
#FOR(%ScreenField)
#IF(%ScreenFieldUse)
#SET(%Fld,%ScreenFieldUse)
#FIX(%Field,%ScreenFieldUse)
#IF(SUB(%Fld,1,1) <> '?')
#IF(%FieldID)
#IF(UPPER(%FieldFile) = UPPER(%Primary))
Dup::%ScreenFieldUse = %ScreenFieldUse #<!Save screen entry
#ENDIF
#ENDIF
#ENDIF
#ENDIF
#ENDFOR
#!***************************************************************************
#GROUP(%DupFldCall)
IF KEYCODE() = %CopyKey #<!User requested field copy
DO DupField #<!Call duplication Routine
END #<!End copy key check
#!***************************************************************************
#GROUP(%DupField)
!─────────────────────────────────────────────────────────────────────────────
DupField ROUTINE
CASE SELECTED() !Which field is selected?
#FOR(%ScreenField)
#IF(%ScreenFieldUse)
#SET(%Fld,%ScreenFieldUse)
#FIX(%Field,%ScreenFieldUse)
#IF(SUB(%Fld,1,1) <> '?')
#IF(%FieldID)
#IF(UPPER(%FieldFile) = UPPER(%Primary))
OF ?%ScreenFieldUse
%ScreenFieldUse = Dup::%ScreenFieldUse #<!Move saved entry to screen
#ENDIF
#ENDIF
#ENDIF
#ENDIF
#ENDFOR
END #<!End Case Selected
DISPLAY #<!Update screen display
#!***************************************************************************
#GROUP(%InitButtonExist)
#FIX(%ScreenField,'?Previous_Page')
#IF(%ScreenField)
#SET(%PrevExist,'1')
#ELSE
#SET(%PrevExist,%NULL)
#ENDIF
#FIX(%ScreenField,'?Next_Page')
#IF(%ScreenField)
#SET(%NextExist,'1')
#ELSE
#SET(%NextExist,%NULL)
#ENDIF
#FIX(%ScreenField,'?Base_Page')
#IF(%ScreenField)
#SET(%BaseExist,'1')
#ELSE
#SET(%BaseExist,%NULL)
#ENDIF
#FIX(%ScreenField,'?Last_Page')
#IF(%ScreenField)
#SET(%LastExist,'1')
#ELSE
#SET(%LastExist,%NULL)
#ENDIF
#FIX(%ScreenField,'?Ok')
#IF(%ScreenField)
#SET(%OkayExist,'1')
#ELSE
#SET(%OkayExist,%NULL)
#ENDIF
#!***************************************************************************
#GROUP(%AltKeys)
#IF(%Page2Proc)
OF Alt2 !Hotkey to Page 2
PRESS(AltN) !Press Next_Page Key
#ENDIF
#IF(%Page3Proc)
OF Alt3 !Hotkey to Page 3
LOC:Page = 2 !Press Next_Page Key
PRESS(AltN)
#ENDIF
#IF(%Page4Proc)
OF Alt4 !Hotkey to Page 4
LOC:Page = 3 !Press Next_Page Key
PRESS(AltN)
#ENDIF
#IF(%Page5Proc)
OF Alt5 !Hotkey to Page 5
LOC:Page = 4 !Press Next_Page Key
PRESS(AltN)
#ENDIF
#IF(%Page6Proc)
OF Alt6 !Hotkey to Page 6
LOC:Page = 5 !Press Next_Page Key
PRESS(AltN)
#ENDIF
#IF(%Page7Proc)
OF Alt7
LOC:Page = 6 !Hotkey to Page 7
PRESS(AltN) !Press Next_Page Key
#ENDIF
#IF(%Page8Proc)
OF Alt8
LOC:Page = 7 !Hotkey to Page 8
PRESS(AltN) !Press Next_Page Key
#ENDIF
#IF(%Page9Proc)
OF Alt9
LOC:Page = 8 !Hotkey to Page 9
PRESS(AltN) !Press Next_Page Key
#ENDIF
#!***************************************************************************
#GROUP(%ProcCounter)
#IF(%Page2Proc)
#SET(%ProcCount,'2')
#IF(%Page3Proc)
#SET(%ProcCount,(%ProcCount + 1))
#ENDIF
#IF(%Page4Proc)
#SET(%ProcCount,(%ProcCount + 1))
#ENDIF
#IF(%Page5Proc)
#SET(%ProcCount,(%ProcCount + 1))
#ENDIF
#IF(%Page6Proc)
#SET(%ProcCount,(%ProcCount + 1))
#ENDIF
#IF(%Page7Proc)
#SET(%ProcCount,(%ProcCount + 1))
#ENDIF
#IF(%Page8Proc)
#SET(%ProcCount,(%ProcCount + 1))
#ENDIF
#IF(%Page9Proc)
#SET(%ProcCount,(%ProcCount + 1))
#ENDIF
#ENDIF
#!***************************************************************************
#GROUP(%SavePrimedFields)
#FOR(%Key)
#IF(%KeyAuto)
#FOR(%KeyField)
#IF(%KeyField <> %KeyAuto)
Prime::%KeyField LIKE(%KeyField)
#ENDIF
#ENDFOR
#ENDIF
#ENDFOR
#!***************************************************************************
#GROUP(%DeclareAutoInc)
#!
#!┌────────────────────────────┤Template Group├────────────┬─────────────────┐
#!│ DeclareAutoInc │Version: 3007.105│
#!├──────────────────────────────┤Description├─────────────┴─────────────────┤
#!│Purpose: Generate AutoIncrement Declarations │
#!│Called From: Form, MultiPage, Form21, Child Templates │
#!│Assumptions: None │
#!│Inserts: None │
#!│Symbols Set: None │
#!│Notes: None │
#!├───────────────────────────────┤Comments├─────────────────────────────────┤
#!│Version Comments │
#!│──────── ────────────────────────────────────────────────────────────────│
#!│3007.105 Added to 3007.105 templates │
#!└──────────────────────────────────────────────────────────────────────────┘
#!
#SET(%GenAutoInc,%Null)
#SET(%AutoIncDups,%Null)
#FOR(%Key)
#IF(NOT %KeyAuto)
#IF(%KeyDuplicate)
#SET(%AutoIncDups,'TRUE')
#ENDIF
#ENDIF
#ENDFOR
#SET(%KeyFieldList,%Null)
#FOR(%Key)
#IF(%KeyAuto)
#SET(%GenAutoInc,'TRUE')
#FOR(%KeyField)
#IF(%KeyField=%KeyAuto)
#BREAK
#ENDIF
#SET(%KeyFieldEntry,('['&CLIP(%KeyField)&']'))
#IF((INSTRING(%KeyFieldEntry,%KeyFieldList,1,1)))
#ELSE
#FIX(%Field,%KeyField)
#IF(%FieldType='GROUP')
Auto:%KeyField STRING(SIZE(%KeyField)) #<! Pre-AutoInc Save Value
#ELSE
Auto:%KeyField LIKE(%KeyField) #<! Pre-AutoInc Save Value
#ENDIF
#SET(%KeyFieldList,(CLIP(%KeyFieldList)&%KeyFieldEntry))
#ENDIF
#ENDFOR
Auto:%KeyAuto LIKE(%KeyAuto) #<! AutoInc Save Value
#IF(%AutoIncDups)
Auto:Hold:%KeyAuto LIKE(%KeyAuto) #<! AutoInc Save Value
#ENDIF
#ENDIF
#ENDFOR
#IF(%GenAutoInc)
AutoIncAdd BYTE(0)
#ENDIF
#IF(%PrimaryDriver = 'Paradox3')
#FIX(%File,%Primary)
SavePointer STRING(SIZE(%FilePre:Record)) !Position of current record
#IF(%GenAutoInc)
AutoAddPtr STRING(SIZE(%FilePre:Record)) !Position of Autoinc record
#ENDIF
#ELSE
SavePointer STRING(10) !Position of current record
#IF(%GenAutoInc)
AutoAddPtr STRING(10) !Position of Autoinc record
#ENDIF
#ENDIF
#CHAIN('MiscGrps.TPX')